;
;
;	THIS IS THE "ORIGINAL" EXTENDED SYNAX LISP EVALUATOR.
;	IT IS REPLACED BY THE CURRENT "PROB8.M11"
;
;
		.SBTTL THE EVALUATOR

;		FORREST W. HOWARD JR.
;		CENTER FOR RESEARCH IN COMPUTING TECHNOLOGY
;		AIKEN COMPUTATION LAB.
;		CAMBRIDGE, MA. 02138
;
;
	
		.RSECT	SHRCODE CON

		;THE EVALUATOR
EVAL:
.IF	DF,NOEVAL	
	.IFT
	 .IF	EQ,NOEVAL-1	;NOEVAL IS DEFINED AS 1 FOR THIS FEATURE
		TSTB	TRACFLG
		BEQ	1$
		PROPUSH A
		NPUSH #ANIL
		CALL	PRINTR
		OUTSTR	LINEFEED
		CALL	DMPPORT
		CMP	-(NP),-(NP)
		UNPROPOP A
1$:
	  .ENDC
	 .ENDC
	TSTB	INTFLG
	BEQ	P832$
	PROPUSH	A
	ERROR	</↑C INTERRUPT/>,31$
31$:	UNPROPOP A
P832$:	DISPATCH		;TTHE REAL CODE
	RET			;A NUMBER--RETURN IT
	.WORD 0
	BR	EDTPR		;A DTPR--BRANCH TO EDTPR FOR IT
	.WORD	0
	BR	EATOM		;AN ATOM--LETS GETS ITS BINDING
	.WORD	0
	RET			;BCD--WHAT ELSE CAN WE DO WITH IT
	.WORD 0
	RET			;SAME GO FOR PORTS
EATOM:	JMPIFTR	A,ERET		;IF TRUE,RETURN IT
	JMPIFNIL A,ERET		;IF NIL,RETURN IT
	CALL	LOOKUP		;OTHERWISE FIND ITS BINDING
	MOV	2(A),A		;AND MOVE IT TO A
ERET:	RET			;THEN GO HOME
EDTPR:	PUSH	A		;MAKE A FN BLOCK--LIKE SO



;	SNAG(EEXIT)
;	FUNCTION
;	PTR TO NP
;	FORM
;	REAL RETURN



	PUSH	NP
	PUSH	(A)
	PUSH	#EEXIT
	CAR	A,A		;LETS SEE WHAT CAR OF A HAS FOR US
EVFL:	DISPATCH		;CAN BE ANYTHING
	 BR	EVERROR		;NUMBERS MAKE BAD FUNCTIONS
	.WORD	0
	JMP	EVDTPR		;IF A DTPR, LETS SEE WHAT IT LOOKS LIKE
	 BR	EVATOM		;IF AN ATOM, GO TO GET ITS FUNCTION BINDING
	.WORD	0
	 BR	EVBCD		;IF ITS BCD, THEN GO TO CODE THAA KNOWS
	.WORD	0		;WHAT DO DO WITH IT
EVERROR:ERROR	</BAD FUNCTION/>,EVFL		;GIVE THE POOR USER A CHANCE TO SUPPLY
				; A NEW FUNCTION

EVATOM:	JMPIFNIL A,EVERROR		;NIL ALSO MAKES A PRETTY
					; MISSERABLE FUNCTION
	JMPIFNIL 4(A),EVASEARCH		;IF THE FUNCTION BINDING IS NIL,
					; THEN GET CURRENT BINDING
	MOV	4(A),A			;THE FNB WAS NON-NIL--LETS SEE
					; WHAT IS
	CMPTYPE	A,J1,#NDTPR		;IS IT A DTPR?
	BNE	EVFL			;I.E. GO IF NOT DTPR		;
	CAR	A,J1			;GETS ITS CAR--SHOULD BE
					; LAMBDA OR NLAMBDA
	CMP	J1,#ALAMBDA
	BEQ	EVLCD			;IF THEY ARE GO TO APPROPRIATE
					; PLACES
	CMP	J1,#ANLAMBDA
	BNE	EVERROR			;IF NOT (N)LAMBDA, WE HAVE AN
					; ERROR
EVNLCD:	MOV	6(SP),J1		;CODE TO EVALUAATE NLAMBDA
	CDR	J1,J1
	NPUSH	J1			;GET ARG LIST ON STACK
EVCMN:	CDR	A,B			;GET  BOUND VARS
	MOV	@2(B),A			;GET CADR(B)
	CAR	B,B
	MOV	4(SP),J1
	MOV	LTOP,4(SP)
	MOV	J1,LTOP
	CALL	STKB			;GET NAMES
	CALL	EVAL			;AND GO EVALUATE BODY
	RET
EVLCD:	MOV	A,2(SP)			;THIS IS THE LAMBDA CODE
	MOV	6(SP),B			;SAVE FUNCTION BINDING, 
	CDR	B,B			;AND GET LIST OF FORMS TO BE 
	CALL	EVALB			;EVALED AND STACKED
	MOV	2(SP),A			;NOW GET THE FUNCTION BACK
	BR	EVCMN			;AND GO TO GET THE ARGS STACKED
					; AND BODY EVALED

EVASEARCH:	CALL EATOM		;THIS GETS THE BINDING WHEN THE
					;FUNCTION CELL ISN'T AVAIL
	JMPIFTR	A,EVERROR		;LET US PREVENT LOOPS
	BR	EVFL			;GOTO  THE EVAL DISPATCH TO
					; FIGURE OUT WHAT TO DO
EVBCD:	TST	(A)			;IF OUR BCD LAM OR NLAM
	BGE	EVSBR			;IF LAM
EVFSBR:	MOV	6(SP),J1		;MUST BE NLAM
	CDR	J1,J1			;SO GET ARG
	NPUSH	J1			;STACK IT
	BR EVSCD			;AND GO TO CODE TO EXEC THE SUBR
EVSBR:	MOV	A,2(SP)			;IF SUBR,SAVE THEFNB
	MOV	6(SP),B			;GET THE ARGS
	CDR	B,B		
	CALL	EVALB			;GET THEM ON STACK
	MOV	2(SP),A			;NOW GET FUNCTION BACK
EVSCD:	MOV	4(SP),J1
	MOV	LTOP,4(SP)
	MOV	J1,LTOP
.IF	EQ,MULTISEG		
	.IFT
	JMP	4(A)			;IF ONE SEG, BR TO THE ENTRY
	.IFF
	JMP	@4(A)			;IF TWOSEG, BR TO THE ADDRES IN
					; THE BCDP
.ENDC
EVDTPR:	CAR	A,J1			;HERE IF THE FUNCTION IS A DTPR
	CMP	J1,#ALAMBDA		;CAN  WE  PICK OU NLAM OR LAM
	BEQ	EVLCD			;IF YES, USE THAT AS FUNCTION
	CMP	J1,#ANLAMBDA
	BEQ	EVNLCD
	CALL	EDTPR			;OTHERWISE ASSUME THAT THIS IS A
					; FUNCTION CALL,EVAL IT
	JMP	EVFL			;AND TRY TO USE WHAT COMES BACK